home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Tutorial Material / Zone Tutorial / Structure Examples / 5. Struct2 < prev    next >
Lisp/Scheme  |  1998-10-26  |  2KB  |  77 lines
  1. ;  STRUCT2 - for solo keyboard (pt1)
  2.  
  3. (gen-hopalong-symbol xmel (a g) ymel (a g) 100 200 300 0.45 32 0)
  4.  
  5. (setq mel1 (find-change xmel))
  6. (setq mel2 (find-change ymel))
  7.  
  8. (gen-hopalong-vector tonx tony 100 200 300 0.45 7 0) 
  9.  
  10. (create-tonality scale1 (vector-to-list (vector-round 1 12 tonx))) 
  11. (create-tonality scale2 (vector-to-list (vector-round 1 12 tony)))
  12.  
  13. (gen-hopalong-symbol xmel1 (a g) ymel2 (a g) 100 300 500 0.45 24 0)
  14.  
  15. (setq mel3 (find-change xmel1))
  16. (setq mel4 (find-change ymel2))
  17.  
  18. (gen-hopalong-vector ton1x ton1y 100 300 500 0.45 7 0) 
  19. (create-tonality scale3 (vector-to-list (vector-round 1 12 ton1x)))
  20. (create-tonality scale4 (vector-to-list (vector-round 1 12 ton1y)))
  21.  
  22. (gen-hopalong-symbol xmel3 (a g) ymel4 (a g) 100 500 700 0.45 12 0)
  23.  
  24. (setq mel5 (find-change xmel3))
  25. (setq mel6 (find-change ymel4))
  26.  
  27. (gen-hopalong-vector ton2x ton2y 100 500 700 0.45 7 0) 
  28. (create-tonality scale5 (vector-to-list (vector-round 1 12 ton2x)))
  29. (create-tonality scale6 (vector-to-list (vector-round 1 12 ton2y)))
  30.  
  31. ; Nigel has been using tick value 96 for 1/4 note. 
  32. ; Because Nigel often mixes ticks and ratios, the function must take
  33. ; both cases into account.
  34.  
  35. (defun use-nigel-ticks (l)
  36.   (let (out)
  37.     (dolist (x l)
  38.       (if (is-length-symbol x)
  39.         (push x out)
  40.         (push (* x 5) out)))
  41.     (nreverse out)))
  42.  
  43. (setq rhy1 (use-nigel-ticks (append (symbol-repeat 28 '(48)) '(24 24 24 24))))
  44. (setq rhy2 (use-nigel-ticks (append (symbol-repeat 21 '(48)) '(32 32 32))))
  45. (setq rhy3 (use-nigel-ticks (append (symbol-repeat 10 '(48)) '(96 96))))
  46.  
  47. (setq zone1 (list (make-zone rhy1) (make-zone rhy2) (make-zone rhy3))) 
  48. ; --> (1440 1104 672)
  49.  
  50. (def-symbol
  51.   pnrh (append mel1 mel3 mel5)
  52.   pnlh (append mel2 mel4 mel6)
  53. )
  54.  
  55. (def-length
  56.   pnrh (append rhy1 rhy2 rhy3)
  57.   pnlh (append rhy1 rhy2 rhy3)  
  58. )
  59.  
  60. (def-tonality
  61.   pnrh (activate-tonality (scale1 c 6) (scale3 c 6) (scale5 c 6))
  62.   pnlh (activate-tonality (scale2 c 5) (scale4 c 5) (scale6 c 5))
  63. )
  64.  
  65. (def-zone
  66.   pnrh zone1  
  67.   pnlh zone1
  68. )
  69.  
  70. (compile-instrument-p "ccl;output:" "pno"
  71.   pnrh
  72.   pnlh  
  73. )
  74.  
  75.  
  76.  
  77.